(*******************************************************************************
* Server of virtual timers:                                                    *
*     - Interval (msec) start/stop and autorestartable.                        *
*     - Periodic (seconds-months), synchronized with system time.              *
* Notification with Event object or messages.                                  *
*******************************************************************************)
unit Timers;

interface

uses Windows,Classes,SysUtils,Notify,Cron,TimerDef;

const
  stEnable    = 0;
  stDisable   = 1;
  stMask      = $80;

  ttInterval  = 1;
  ttFixed     = 2;

  SleepTime   = 10;

type
  (* Base virtual timer *)
  TTimer = class
  private
    fNotifier : TNotify;
    function GetActive: boolean;
    procedure SetActive(Run : boolean);
  protected
    fMode,fStatus : byte;
    procedure Tick;
  public
    constructor Create(NotifyObj : TNotify; Mode : byte; Run : boolean);
    destructor Destroy; override;
    property Active : boolean read GetActive write SetActive;
    property Mode : byte read fMode write fMode;
    procedure Reset; virtual; abstract;
  end;

  (* Interval timer object *)
  TIntervalTimer = class(TTimer)
  private
    fInterval,
    fCurrent : dword;
  public
    constructor Create(NotifyObj : TNotify; Mode : byte; Run : boolean; Int : dword);
    property Interval : dword read fInterval write fInterval;
    procedure Update(Increment : dword);
    procedure Reset; override;
  end;

  (* Synchronized timer object *)
  TFixedTimer = class(TTimer)
  private
    fTimeMask : TCron;
    fLastTime : TSystemtime;
    procedure SetCron(const CronMask : shortstring);
    function GetNextTime : TSYSTEMTIME;
  public
    constructor Create(NotifyObj : TNotify; Mode : byte; Run : boolean; const CronMask : shortstring);
    destructor Destroy; override;
    property TimeMask : shortstring write SetCron;
    property LastTime : TSYSTEMTIME read fLastTime write fLastTime;
    property NextTime : TSYSTEMTIME read GetNextTime;
    procedure Update(const CheckTime : TSystemTime);
    procedure Reset; override;
  end;

  (* Virtual timer manager object *)
  TTimerManager = class(TThread)
  private
    TimerList,
    AlarmList : TThreadList;
    LastTicks : dword;
    LastSecond : word;
  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddTimer(Item : TTimer);
    procedure DeleteTimer(Item : TTimer);
  end;

var Server : TTimerManager;

implementation

{$Q-}

(*** TTimer ***)

constructor TTimer.Create(NotifyObj : TNotify; Mode : byte; Run : boolean);
  begin
    fNotifier := NotifyObj;
    fNotifier.Owner := THandle(Self);
    Active := Run;
    Self.Mode := Mode;
  end;

destructor TTimer.Destroy;
  begin
    fNotifier.Free;
    inherited;
  end;

function TTimer.GetActive: boolean;
  begin
    result := fStatus and stDisable = 0;
  end;

procedure TTimer.SetActive(Run : boolean);
  begin
    if Run then fStatus := fStatus and not stDisable
    else fStatus := fStatus or stDisable;
  end;

procedure TTimer.Tick;
  begin
    if Mode and tmStartStop <> 0 then Active := false;
    fNotifier.Execute;
  end;

(*** TTimerManager ***)

constructor TTimerManager.Create;
  begin
    inherited Create(true);
    Priority := tpTimeCritical;
    TimerList := TThreadList.Create;
    AlarmList := TThreadList.Create;
    Resume;
  end;

destructor TTimerManager.Destroy;
  var i : integer;
  begin
    Terminate;
    WaitFor;
    with TimerList.LockList do try
      for i := 0 to Count-1 do TTimer(Items[i]).Free;
    finally
      TimerList.UnlockList;
    end;
    TimerList.Free;
    with AlarmList.LockList do try
      for i := 0 to Count-1 do TTimer(Items[i]).Free;
    finally
      AlarmList.UnlockList;
    end;
    AlarmList.Free;
  end;

procedure TTimerManager.AddTimer(Item : TTimer);
  begin
    if Item is TIntervalTimer then
      begin
        with TimerList.LockList do Add(Item);
        TimerList.UnlockList;
      end
    else
      begin
        with AlarmList.LockList do Add(Item);
        AlarmList.UnlockList;
      end
  end;

procedure TTimerManager.DeleteTimer(Item : TTimer);
  begin
    if Item is TIntervalTimer then
      begin
        with TimerList.LockList do Remove(Item);
        TimerList.UnlockList;
      end
    else
      begin
        with AlarmList.LockList do Remove(Item);
        AlarmList.UnlockList;
      end;
    Item.Free;
  end;

procedure TTimerManager.Execute;
  var Ticks,Diff : dword;
      i : integer; Time : TSYSTEMTIME;
  begin
    LastTicks := GetTickCount;
    while not Terminated do
      begin
        Sleep( SLEEPTIME - (GetTickCount mod SLEEPTIME) );
        Ticks := GetTickCount;
        Diff := Ticks-LastTicks;
        LastTicks := Ticks;

        with TimerList.LockList do try
          for i := 0 to Count-1 do
            begin
              if Terminated then exit;
              TIntervalTimer(Items[i]).Update(Diff);
            end;
        finally
          TimerList.UnlockList;
        end;

        GetLocalTime(Time);
        if Time.wSecond = LastSecond then continue;
        LastSecond := Time.wSecond;

        with AlarmList.LockList do try
          for i := 0 to Count-1 do
            begin
              if Terminated then exit;
              TFixedTimer(Items[i]).Update(Time);
            end;
        finally
          AlarmList.UnlockList;
        end;
      end;
  end;


(*** TIntervalTimer ***)

constructor TIntervalTimer.Create(NotifyObj: TNotify; Mode: byte;
  Run: boolean; Int: dword);
  begin
    inherited Create(NotifyObj, Mode, Run);
  end;

procedure TIntervalTimer.Reset;
  begin
    fCurrent := 0;
  end;

procedure TIntervalTimer.Update(Increment : dword);
  begin
    if not Active then exit;
    inc(fCurrent, Increment);
    if fCurrent < Interval then exit;
    fCurrent := fCurrent mod Interval;
    if Mode and tmStartStop <> 0 then fCurrent := 0;
    Tick;
  end;


(*** TFixedTimer ***)

constructor TFixedTimer.Create(NotifyObj: TNotify; Mode: byte;
  Run: boolean; const CronMask: shortstring);
  begin
    inherited Create(NotifyObj, Mode, Run);
    fTimeMask := TCron.Create;
    TimeMask := CronMask;
  end;

destructor TFixedTimer.Destroy;
  begin
    fTimemask.Free;
    inherited;
  end;

procedure TFixedTimer.Reset;
  begin
    fStatus := fStatus or stMask;
  end;

procedure TFixedTimer.SetCron(const CronMask: shortstring);
  begin
    fTimeMask.Init(CronMask);
    Reset;
  end;

function TFixedTimer.GetNextTime : TSYSTEMTIME;
  begin
    GetLocalTime(result);
    fTimeMask.GetNextCronTime(result);
  end;

procedure TFixedTimer.Update(const CheckTime : TSystemTime);
  var T : TSystemTime;
  begin
    if not Active then exit;
    if fTimeMask.IsCron(CheckTime) then  // Normal match
      begin
        Tick; LastTime := CheckTime;
      end
    else if Mode = tmSureSync then      // Check last unhandled moment
      begin
        T := CheckTime;
        fTimeMask.GetLastCronTime(T);
        if fStatus and stMask <> 0 then // First checking for LastTime was masked
          begin
            LastTime := T;
            fStatus  := fStatus and not stMask;
          end
        else if not IsEqualTime(T, LastTime) then // Match last unhandled moment
          begin
            Tick; LastTime := T;
          end;
      end;
  end;

initialization
  Server := TTimerManager.Create;
finalization
  Server.Free;
end.
